if (!require(tidyverse)) {
install.packages('tidyverse')
}
if (!require(knitr)) {
install.packages('knitr')
}
if (!require(wesanderson)) {
install.packages('wesanderson')
}
if (!require(devtools)) {
install.packages('devtools')
}
if (!require(scorequaltrics)) {
devtools::install_github('jflournoy/qualtrics')
}palettegreen = "#93c47d"
palette3 = c("#93C47D", "#2E6171", "#333333")# define variables
cred_file_location = '~/credentials.yaml.DEFAULT'
sid_column_name = '(subjectID)'
survey_name_filter = 'Freshman Project T1$'
sid_pattern = 'FP[0-9]{3}'
exclude_sid = c('FP999','999') # subject IDs to exclude
identifiableData = c('IPAddress') # exclude when printing duplicates
# load credential file
credentials = scorequaltrics::creds_from_file(cred_file_location)
# filter
surveysAvail = scorequaltrics::get_surveys(credentials)
surveysFiltered = filter(surveysAvail, grepl(survey_name_filter, SurveyName))
# get survey
surveys = scorequaltrics::get_survey_responses(credentials,
surveyid = surveysFiltered$SurveyID[[1]])
# tidy surveys
surveys1 = surveys %>%
# select responses matching subject ID pattern
filter(grepl(sid_pattern, subjectID)) %>%
# exclude test responses
filter(!subjectID %in% exclude_sid)
# check number of observations
surveys1 %>%
group_by(subjectID) %>%
summarize(n = n()) %>%
arrange(desc(n))# select relevant columns
EDEQS = surveys1 %>%
select(subjectID, SEX, starts_with("GENDER"), starts_with("EDE")) %>%
# score EDE-QS
mutate_at(vars(starts_with("EDE")), as.numeric) # convert to integer# calculate mean across all items
total = EDEQS %>%
gather(EDEQS, value, starts_with("EDE")) %>%
group_by(subjectID) %>%
summarize(total = mean(value, na.rm = TRUE))
# calculate mean for restraint items
restrained = EDEQS %>%
gather(EDEQS, value, starts_with("EDE")) %>%
filter(EDEQS %in% c("EDE_QS_1", "EDE_QS_2")) %>%
group_by(subjectID) %>%
summarize(restrained = mean(value, na.rm = TRUE))
# calculate mean for binge items
binge = EDEQS %>%
gather(EDEQS, value, starts_with("EDE")) %>%
filter(EDEQS %in% c("EDE_QS_3", "EDE_QS_9", "EDE_QS_10")) %>%
group_by(subjectID) %>%
summarize(binge = mean(value, na.rm = TRUE))
EDEQS = left_join(EDEQS, total, by = "subjectID") %>%
left_join(., restrained, by = "subjectID") %>%
left_join(., binge, by = "subjectID")EDEQS %>%
gather(score, mean, total, restrained, binge) %>%
ggplot(aes(score, mean)) +
geom_boxplot() +
geom_jitter(width = .2, alpha = .5, color = palettegreen) +
theme_minimal()EDEQS %>%
gather(score, mean, total, restrained, binge) %>%
ggplot(aes(score, mean)) +
geom_violin() +
geom_jitter(width = .1, alpha = .5, color = palettegreen) +
theme_minimal()# define variables and paths
sub_dir = "~/Dropbox (PfeiBer Lab)/FreshmanProject/Tasks/ROC-C/output/FP/"
sub_pattern = "FP[0-9]{3}"
subjects = list.files(sub_dir, pattern = sub_pattern)
runs = c("run1", "run2", "run3")
# initialize data frame
data = data.frame()
# loop through subjects and load data
for (sub in subjects) {
for (run in runs) {
file = paste0(sub_dir, sub, '/', sub, '_', run,'.csv')
tmp = tryCatch(read.csv(file, stringsAsFactors = FALSE) %>%
mutate(subjectID = sub,
run = run,
respCue = as.integer(as.character(respCue)),
respRating = as.integer(as.character(respRating)),
respEffort = as.integer(as.character(respEffort))), error = function(e) NULL)
data = bind_rows(data, tmp)
rm(tmp)
}
}task = data %>%
# exclude FP001 and FP999
filter(!subjectID %in% c("FP001", "FP999")) %>%
# recode values
mutate(rtCue = ifelse(rtCue == "NaN", NA, rtCue), # NaN as NA
rtRating = ifelse(rtRating == "NaN", NA, rtRating), # NaN as NA
rtEffort = ifelse(rtEffort == "NaN", NA, rtEffort), # NaN as NA
action = ifelse(respCue == 6, "look", # cue button presses
ifelse(respCue == 7, "regulate", NA)),
action = ifelse(cond == "LOOK" & is.na(respCue), "look", # missing cue button presses
ifelse(cond == "REGULATE" & is.na(respCue), "regulate", action)),
action = as.factor(action), # change to factor
choice = ifelse(cond %in% c("LOOK", "REGULATE"), "no", # choice values
ifelse(cond == "CHOOSE", "yes", NA)),
choice = as.factor(choice), # change to factor
respRating = respRating - 5, # recode button box presses to 1-4 scale
respRating = as.integer(respRating), # change to integer
respEffort = respEffort - 5, # recode button box presses to 1-4 scale
respEffort = as.integer(respEffort)) %>% # change to integer
# add trial number
group_by(subjectID) %>%
mutate(trial = row_number()) %>%
# reorder columns
select(subjectID, run, trial, action, choice, cond, respCue, everything()) %>%
ungroup()reg.success = task %>%
# remove missing data
filter(!is.na(action)) %>%
# group by subject and calculate mean
group_by(subjectID, action) %>%
summarize(mean = mean(respRating, na.rm = TRUE)) %>%
# calculate regulation success
spread(action, mean) %>%
mutate(reg.success = look - regulate)reg.success %>%
gather(score, mean, look, regulate, reg.success) %>%
ggplot(aes(score, mean)) +
geom_boxplot() +
geom_jitter(width = .2, alpha = .5, color = palettegreen) +
theme_minimal()reg.success %>%
gather(score, mean, look, regulate, reg.success) %>%
filter(score == "reg.success") %>%
mutate(score = ifelse(score == "reg.success", "reappraisal ability", score)) %>%
ggplot(aes(score, mean)) +
geom_boxplot() +
geom_jitter(width = .2, alpha = .5, color = palettegreen) +
theme_minimal()reg.success %>%
gather(score, mean, look, regulate, reg.success) %>%
ggplot(aes(score, mean)) +
geom_violin() +
geom_jitter(width = .1, alpha = .5, color = palettegreen) +
theme_minimal()reg.success %>%
gather(action, mean, look, regulate) %>%
ggplot(aes(action, mean)) +
geom_point(aes(group = subjectID), color = palettegreen, alpha = .1, size = 3) +
geom_line(aes(group = subjectID), color = palettegreen, alpha = .1, size = 1) +
stat_summary(aes(group = 1), color = palettegreen, fun.y = mean, geom = "line", size = 2) +
stat_summary(color = palettegreen, fun.data = "mean_cl_boot", size = 1.5) +
labs(y = "mean craving rating") +
theme_minimal()task %>%
filter(!is.na(action)) %>%
group_by(action) %>%
summarize(mean = mean(respRating, na.rm = TRUE),
sd = sd(respRating, na.rm = TRUE),
n = n()) %>%
kable(digits = 2, format = "pandoc", caption = "craving ratings")| action | mean | sd | n |
|---|---|---|---|
| look | 3.01 | 0.92 | 2430 |
| regulate | 2.16 | 0.86 | 2217 |
effort = task %>%
filter(action == "regulate") %>%
group_by(subjectID) %>%
summarize(meanEffort = mean(respEffort, na.rm = TRUE))effort %>%
gather(score, mean, meanEffort) %>%
mutate(score = ifelse(score == "meanEffort", "effort", score)) %>%
ggplot(aes(score, mean)) +
geom_boxplot() +
geom_jitter(width = .2, alpha = .5, color = palettegreen) +
theme_minimal()effort %>%
gather(score, mean, meanEffort) %>%
mutate(score = ifelse(score == "meanEffort", "effort", score)) %>%
ggplot(aes(score, mean)) +
geom_violin() +
geom_jitter(width = .1, alpha = .5, color = palettegreen) +
theme_minimal()# merge data
merged = left_join(reg.success, EDEQS, by = "subjectID") %>%
left_join(., effort, by = "subjectID")Example stats reporting format: r = .19, 95% CI = [-.077, .44], t(51) = 1.44, p = .156
# total
cor.test(merged$reg.success, merged$total)##
## Pearson's product-moment correlation
##
## data: merged$reg.success and merged$total
## t = 1.4399, df = 51, p-value = 0.156
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.07674486 0.44421149
## sample estimates:
## cor
## 0.1976489
# restrained
cor.test(merged$reg.success, merged$restrained)##
## Pearson's product-moment correlation
##
## data: merged$reg.success and merged$restrained
## t = 1.2412, df = 51, p-value = 0.2202
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.1038586 0.4220034
## sample estimates:
## cor
## 0.1712424
# binge
cor.test(merged$reg.success, merged$binge)##
## Pearson's product-moment correlation
##
## data: merged$reg.success and merged$binge
## t = 1.1514, df = 51, p-value = 0.255
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.1161222 0.4117471
## sample estimates:
## cor
## 0.1591674
# total
cor.test(merged$meanEffort, merged$total)##
## Pearson's product-moment correlation
##
## data: merged$meanEffort and merged$total
## t = -0.050249, df = 51, p-value = 0.9601
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.2768035 0.2637593
## sample estimates:
## cor
## -0.00703611
# restrained
cor.test(merged$meanEffort, merged$restrained)##
## Pearson's product-moment correlation
##
## data: merged$meanEffort and merged$restrained
## t = -1.9968, df = 51, p-value = 0.0512
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.502964856 0.001094393
## sample estimates:
## cor
## -0.2692791
# binge
cor.test(merged$meanEffort, merged$binge)##
## Pearson's product-moment correlation
##
## data: merged$meanEffort and merged$binge
## t = 1.6486, df = 51, p-value = 0.1054
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.04829991 0.46684152
## sample estimates:
## cor
## 0.2249304
merged %>%
gather(score, mean, total, restrained, binge) %>%
ggplot(aes(mean, reg.success)) +
geom_point(color = palettegreen, alpha = .5) +
geom_smooth(method = "lm", color = palettegreen, size = 2) +
facet_grid(~score) +
labs(x = "mean score", y = "reappraisal ability (look- regulate)") +
theme_minimal()merged %>%
gather(score, mean, total, restrained, binge) %>%
ggplot(aes(mean, reg.success, color = score)) +
geom_point(alpha = .5) +
geom_smooth(method = "lm", alpha = .2, size = 1.5) +
scale_color_manual(values = palette3) +
labs(x = "mean score", y = "reappraisal ability (look- regulate)") +
theme_minimal()merged %>%
gather(score, mean, total, restrained, binge) %>%
ggplot(aes(mean, meanEffort)) +
geom_point(color = palettegreen, alpha = .5) +
geom_smooth(method = "lm", color = palettegreen, size = 2) +
facet_grid(~score) +
labs(x = "mean score", y = "mean effort rating") +
theme_minimal()merged %>%
gather(score, mean, total, restrained, binge) %>%
ggplot(aes(mean, meanEffort, color = score)) +
geom_point(alpha = .5) +
geom_smooth(method = "lm", alpha = .2, size = 1.5) +
scale_color_manual(values = palette3) +
labs(x = "mean score", y = "mean effort rating") +
theme_minimal()